home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.09 Sep 88 / Dubin Article / TurboPascal Version / PasArea.Pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-03  |  8.2 KB  |  358 lines  |  [TEXT/TPAS]
  1. {            PasArea.Pas                                                                     }
  2. { Copyright 1987 by Stephen Dubin, V.M.D. and Thomas W. Moore, Ph.D.    }
  3. { Prepared with Turbo Pascal V1.0                                       }
  4. { Users of other Pascal systems should particularly check the "preamble"}
  5. { portion of their program (Linking directives, "uses", "includes", etc.}
  6. { also check usage of type "point" - TML doesn't like use of pt.h and   }
  7. { pt.v as control elements in a for statement.                          }
  8.  
  9. program PasArea;    
  10.  
  11. {$R-}               { Turn off range checking               }
  12. {$I-}               { Turn off I/O error checking           }
  13. {$R PasArea.rsrc}   { Identify resource file                }
  14. {$U-}               { Turn off auto link to runtime units   }
  15. {$L ACountPix.Rel } { Link in Assembly Language Segment}
  16. {$D+}               { Embed Procedure Labels                }
  17.  
  18. uses  Memtypes,QuickDraw,OSIntf,ToolIntf,PackIntf;
  19.  
  20. const
  21.   FileMenuID = 1;        { the File menu}
  22.   OptionMenuID = 2;        { the option menu}
  23.   WindResID = 1;        { the resource id of my window}
  24.  
  25. type
  26.   BUF   = array[1..512] of Integer; { Make it bigger if you are really paranoid}
  27.   
  28. var
  29.   myMenus : Array[FileMenuId..OptionMenuID] of MenuHandle; 
  30.   Done : Boolean;            
  31.   MyWindow : WindowPtr;        
  32.   TotalRegion   :   RgnHandle;
  33.   Numpix        :   Longint;
  34.   myBUF        : BUF;
  35.     
  36. function ACountPix( theRegion:RgnHandle) : LongInt; external;
  37.  
  38. function CountPix(theRegion : RgnHandle): LongInt;        
  39. var
  40.  pt : Point;
  41.  rgn    :   Region;
  42.  temp   :   LongInt;
  43.  x    :   Integer;
  44.  y    :   Integer;
  45.   
  46. begin
  47.    temp   :=  0;
  48.    rgn  :=  theRegion^^;
  49.    for  x  := rgn.rgnBBox.left  to  rgn.rgnBBox.right do 
  50.         begin
  51.         pt.h := x;
  52.             for y := rgn.rgnBBox.top to rgn.rgnBBox.bottom do
  53.             begin
  54.         pt.v := y;
  55.                 if  PtInRgn( pt, TheRegion) then  temp := temp + 1;
  56.         end;
  57.         end;
  58.         CountPix := temp;
  59. end;
  60. { Turbo seems to accept pt.h and pt.v as control elements but TML does}
  61. { not. Some format checkers agree with TML}
  62.  
  63. procedure Wipe;        
  64. var
  65.     r   :   Rect;
  66.       
  67. begin
  68.     SetRect(r,0,0,504,300);
  69.     EraseRect(r);
  70.   
  71. end;
  72.  
  73. procedure Data;        
  74. var
  75.     rgn         :   Region;
  76.     rgnpntr     :   Ptr;
  77.     size        :   Integer;
  78.     thebuf      :   BUF;
  79.     bfpntr      :   Ptr;
  80.     myString    :   Str255;
  81.     i           :   Integer;
  82.     x           :   Integer;
  83.     y           :   Integer;
  84.  
  85.  begin
  86.     Wipe;
  87.     TextSize(9);
  88.     TextFont(Monaco);
  89.     rgn  :=  totalRegion^^;
  90.     rgnpntr := ptr(totalRegion^); 
  91.     size := rgn.rgnSize;
  92.     if size > 800 then size:= 800;
  93.     bfpntr := ptr(@thebuf);
  94.     BlockMove(rgnpntr,bfpntr,size);
  95.     MoveTo(10,10);
  96.     DrawString('Here are the first 400 words of the region data. (FLAG = 32767)');
  97.     x := 10;
  98.     y := 20;
  99.     for i  := 1  to  (size div 2) do 
  100.         begin
  101.         MoveTo(x,y);
  102.         NumToString(theBuf[i],myString);
  103.         if theBuf[i] < 32766 then 
  104.             begin
  105.                 if theBuf[i] <10  then DrawString(' ');
  106.                 if theBuf[i] <100 then DrawString(' ');
  107.                 if theBuf[i] < 1000 then DrawString(' ');
  108.                 if theBuf[i] < 10000 then DrawString(' ');
  109.                 DrawString(MyString);
  110.             end;
  111.         if theBuf[i] > 32766 then DrawString(' FLAG');
  112.         x := x + 30;
  113.         if (i mod 16) = 0 then
  114.             begin
  115.             x := 10;
  116.             y := y+10;
  117.             end; 
  118.         end;   
  119. end;
  120.  
  121. procedure OvalRegion;        
  122. var
  123.     RectA : Rect;
  124.       
  125. begin
  126.    Wipe;   
  127.    TotalRegion := NewRgn;
  128.    SetRect(RectA, 170,175,195,200);
  129.    OpenRgn;
  130.    ShowPen;
  131.    FrameOval(RectA);
  132.    HidePen;
  133.    CloseRgn(TotalRegion);   
  134. end;
  135.  
  136. procedure Contour;        
  137. var
  138.     p1  :   Point;
  139.     p2  :   Point;
  140.     OldTick :  Longint;
  141.     
  142. begin
  143.   Wipe;
  144.   TotalRegion := NewRgn;
  145.   OldTick := TickCount;
  146.   Repeat
  147.     GetMouse(p1);
  148.     MoveTo(p1.h,p1.v);
  149.     p2 := p1;  
  150.   Until Button = True;  
  151.   OpenRgn;
  152.   ShowPen;
  153.   PenMode(patXor);  
  154.   Repeat
  155.     GetMouse(p2);
  156.     Repeat Until (OldTick <> TickCount);
  157.     LineTo(p2.h,p2.v);
  158.   Until Button <> True;  
  159.   Repeat Until (OldTick <> TickCount);
  160.   LineTo(p1.h,p1.v);
  161.   PenNormal;
  162.   HidePen;
  163.   CloseRgn(TotalRegion);
  164.   InvertRgn(TotalRegion);
  165. end;
  166.  
  167. procedure Example;        
  168.   
  169. begin
  170.     Wipe;
  171.     OpenRgn;
  172.     TotalRegion := NewRgn;
  173.     ShowPen;
  174.     MoveTo(100,100);
  175.     LineTo(200,100);
  176.     LineTo(200,220);
  177.     LineTo(180,220);
  178.     LineTo(180,150);
  179.     LineTo(125,150);
  180.     LineTo(125,170);
  181.     LineTo(125,170);
  182.     LineTo(100,170);
  183.     LineTo(100,100);
  184.     HidePen;
  185.     CloseRgn(TotalRegion);
  186. end;
  187.  
  188. procedure FreeBox;        
  189. var
  190.     p1  :   Point;
  191.     p2  :   Point;
  192.     p3  :   Point;
  193.     OldTick :  Longint;
  194.     MyRect  :  Rect;
  195.       
  196. begin
  197.     Wipe;
  198.     TotalRegion := NewRgn;
  199.     OldTick := TickCount;
  200.     PenPat(gray);
  201.     PenMode(patXor);    
  202.     Repeat
  203.     GetMouse(p1);
  204.     p2 := p1;  
  205.     Until Button = True;   
  206.     OpenRgn;
  207.     ShowPen;
  208.     PenMode(patXor);    
  209.     Repeat
  210.     Pt2Rect(p1,p2,MyRect);
  211.     Repeat Until (OldTick <> TickCount);
  212.     FrameRect(MyRect);   
  213.         Repeat
  214.             GetMouse(p3);
  215.         Until  EqualPt(p2,p3) <> True;   
  216.    Repeat Until (OldTick <> TickCount);
  217.    FrameRect(MyRect);
  218.    p2 := p3;   
  219.    Until Button <> True;
  220.    Pennormal;
  221.    HidePen;
  222.    PenPat(black);
  223.    FrameRect(MyRect);
  224.    CloseRgn(TotalRegion);
  225.    InvertRgn(TotalRegion);  
  226. end;
  227.  
  228. procedure Area;        
  229. var
  230.     NumTix  :   LongInt;
  231.     MoreTix :   LongInt;
  232.     TicString   :   Str255;
  233.     PixString   :   Str255;  
  234.   
  235. begin   
  236.    TextFont(Monaco);
  237.    TextSize(9);
  238.    TextMode(0);
  239.    MoveTo(10,20); DrawString(' Using Pascal '); 
  240.    NumTix := TickCount;
  241.    NumPix :=  CountPix( TotalRegion ); 
  242.    MoreTix := TickCount - NumTix;
  243.    NumToString(MoreTix,TicString);
  244.    NumToString(NumPix,PixString);
  245.    MoveTo(10,30); DrawString(' Tickcount = ');
  246.    MoveTo(120,30); DrawString(TicString);
  247.    MoveTo(10,40); DrawString(' Pixel Number = ');
  248.    MoveTo(120,40); DrawString(PixString);    
  249.    MoveTo(10,50); DrawString(' Using Tom Terrific '); 
  250.    NumTix := TickCount;
  251.    NumPix :=  ACountPix( TotalRegion ); 
  252.    MoreTix := TickCount - NumTix;
  253.    NumToString(MoreTix,TicString);
  254.    NumToString(NumPix,PixString);
  255.    MoveTo(10,60); DrawString(' Tickcount = ');
  256.    MoveTo(120,60); DrawString(TicString);
  257.    MoveTo(10,70); DrawString(' Pixel Number = ');
  258.    MoveTo(120,70); DrawString(PixString);  
  259. end;
  260.  
  261. procedure ProcessMenu(codeWord : Longint);    
  262. var
  263.   menuNum : Integer;
  264.   itemNum : Integer;
  265.  
  266. begin
  267.   if codeWord <> 0 then    
  268.     begin
  269.       menuNum := HiWord(codeWord);
  270.       itemNum := LoWord(codeWord);
  271.       case menuNum of 
  272.            FileMenuID :Done := true; 
  273.         OptionMenuID :
  274.                begin
  275.                 case ItemNum of
  276.                     1:Contour;      {Contour}
  277.                     2:FreeBox;      {Freebox}
  278.                     3:OvalRegion;   {Oval}
  279.                     4:Example;      {Example}
  280.                     5: Area;        {Area}
  281.                     6:Data;         {Region Data}
  282.                    end; { of ItemNum case}               
  283.        end;{ of MenuNum case}
  284.     end;
  285.   HiliteMenu(0); 
  286.  end;
  287. end;
  288.  
  289. procedure DealWithMouseDowns(theEvent: EventRecord);
  290. var
  291.   location : Integer;
  292.   windowPointedTo : WindowPtr;
  293.   mouseLoc : point;
  294.   windowLoc : integer;
  295.   VandH : Longint;
  296.   Height : Integer;
  297.   Width : Integer;
  298.   
  299.  begin
  300.   mouseLoc := theEvent.where;
  301.   windowLoc := FindWindow(mouseLoc,windowPointedTo);
  302.   case windowLoc of
  303.     inMenuBar : 
  304.       begin
  305.         ProcessMenu(MenuSelect(mouseLoc));
  306.       end;
  307.     
  308.   end;
  309. end;
  310.  
  311. procedure MainEventLoop;
  312. var
  313.   Event : EventRecord;
  314.   theItem : integer;
  315.   
  316. begin
  317.   repeat
  318.     SystemTask;
  319.     if GetNextEvent(everyEvent, Event) then
  320.      begin  
  321.          case Event.what of
  322.           mouseDown : DealWithMouseDowns(Event);
  323.          end;
  324.      end;
  325.   until Done;
  326. end;
  327.  
  328. procedure MakeMenus;        
  329. var
  330.   index : Integer;
  331. begin
  332.   for index := FileMenuId to OptionMenuID do
  333.     begin
  334.       myMenus[index] := GetMenu(index);
  335.       InsertMenu(myMenus[index],0);
  336.     end;
  337.   DrawMenuBar;
  338. end;
  339.  
  340. {                Main Program                       }
  341. begin
  342.   Done := false;        
  343.   FlushEvents(everyEvent,0);    
  344.   InitGraf(@thePort);        
  345.   InitFonts;        
  346.   InitWindows;        
  347.   InitMenus;        
  348.   InitDialogs(nil);
  349.   InitCursor;        
  350.   MoreMasters;
  351.   MoreMasters;
  352.   MakeMenus;        
  353.   MyWindow := GetNewWindow(WindResID,nil,Pointer(-1)); 
  354.   SetPort(MyWindow);    
  355.   TotalRegion := NewRgn;   {Lazy way to avoid bomb if your select "Area" first}  
  356.   MainEventLoop;        
  357. end.
  358.